home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / kcl / akcl / kcl.lha / attport / init_kcl.lsp < prev    next >
Lisp/Scheme  |  1986-09-25  |  3KB  |  56 lines
  1. (in-package "COMPILER")
  2. (in-package "SYSTEM")
  3. (in-package "USER")
  4. (in-package "LISP")
  5. (in-package "USER")
  6. (progn (allocate 'cons 90) (system:init-system) (gbc t)
  7.  (load #"../cmpnew/cmpmain.lsp") (gbc t) (load #"../cmpnew/lfun_list.lsp")
  8.  (gbc t) (load #"../cmpnew/cmpopt.lsp") (gbc t)
  9.  (defun compile-file
  10.   (&rest system::args &aux (*print-pretty* nil) (*package* *package*))
  11.   (compiler::init-env) (apply 'compiler::compile-file1 system::args))
  12.  (defun compile (&rest system::args &aux (*print-pretty* nil))
  13.   (apply 'compiler::compile1 system::args))
  14.  (defun disassemble (&rest system::args &aux (*print-pretty* nil))
  15.   (apply 'compiler::disassemble1 system::args))
  16.  (setq system::*old-top-level* (symbol-function 'system:top-level))
  17.  (defun system::kcl-top-level nil
  18.   (when (> (system:argc) 1)
  19.         (setq system:*system-directory* (system:argv 1)))
  20.   (when (>= (system:argc) 5)
  21.         (let ((system::*quit-tag* (cons nil nil))
  22.               (system::*quit-tags* nil) (system::*break-level* '())
  23.               (system::*break-env* nil) (system::*ihs-base* 1)
  24.               (system::*ihs-top* 1) (system::*current-ihs* 1)
  25.               (*break-enable* nil))
  26.              (system:error-set
  27.               '(let ((system::flags (system:argv 4)))
  28.                     (setq system:*system-directory*
  29.                           (pathname (system:argv 1)))
  30.                     (compile-file (system:argv 2) :output-file
  31.                      (system:argv 3) :o-file
  32.                      (case (schar system::flags 1) (#\0 nil) (#\1 t)
  33.                            (t (system:argv 5)))
  34.                      :c-file
  35.                      (case (schar system::flags 2) (#\0 nil) (#\1 t)
  36.                            (t (system:argv 6)))
  37.                      :h-file
  38.                      (case (schar system::flags 3) (#\0 nil) (#\1 t)
  39.                            (t (system:argv 7)))
  40.                      :data-file
  41.                      (case (schar system::flags 4) (#\0 nil) (#\1 t)
  42.                            (t (system:argv 8)))
  43.                      :system-p
  44.                      (if (char-equal (schar system::flags 0) #\S) t
  45.                          nil))))
  46.              (bye)))
  47.   (format t "KCl (Kyoto Common Lisp)  ~A~%" "Feburary 13, 1986")
  48.   (in-package 'system::user) (funcall system::*old-top-level*))
  49.  (defun lisp-implementation-version nil "Feburary 13, 1986")
  50.  (setq *modules* nil) (gbc t) (system:reset-gbc-count)
  51.  (allocate 'cons 200)
  52.  (defun system:top-level nil (system::kcl-top-level))
  53.  (system:save-system "saved_kcl") (bye)
  54.  (defun system:top-level nil (system::kcl-top-level))
  55.  (save "saved_kcl") (bye))
  56.